home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / accel.lsp next >
Encoding:
Lisp/Scheme  |  1991-10-05  |  3.9 KB  |  109 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         accel.lsp
  5. ; RCS:          $Header: accel.lsp,v 1.2 91/10/05 04:55:33 mayer Exp $
  6. ; Description:  Example of accelerator usage. Load this file, and type letters
  7. ;        [a-z] into any pushbutton widget. each pushbutton widget
  8. ;        has a single accelerator, one of key [a-z], and accelerators for
  9. ;        all other pushbuttons get installed on each pushbutton... THe
  10. ;        accelerator arms the pushbutton, and the pushbutton's arm
  11. ;        callback enters the typed character into the text widget.
  12. ;        Thus, this is a highly rube-goldbergian means of echoing
  13. ;        characters typed into the text widget...
  14. ;        (Note that focus must be on a pushbutton or the textwdget.)
  15. ; Author:       Niels Mayer, HPLabs
  16. ; Created:      Thu Feb 14 07:09:25 1991
  17. ; Modified:     Sat Oct  5 04:54:05 1991 (Niels Mayer) mayer@hplnpm
  18. ; Language:     Lisp
  19. ; Package:      N/A
  20. ; Status:       X11r5 contrib tape release
  21. ;
  22. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  23. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  24. ;
  25. ; Permission to use, copy, modify, distribute, and sell this software and its
  26. ; documentation for any purpose is hereby granted without fee, provided that
  27. ; the above copyright notice appear in all copies and that both that
  28. ; copyright notice and this permission notice appear in supporting
  29. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  30. ; used in advertising or publicity pertaining to distribution of the software
  31. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  32. ; makes no representations about the suitability of this software for any
  33. ; purpose.  It is provided "as is" without express or implied warranty.
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35.  
  36.  
  37. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  38.     (error "accel.lsp doesn't work with Motif 1.0 -- probably a Motif bug\nUse only with >= Motif 1.1")
  39.   (let ()
  40.     (setq top_w
  41.       (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "aclshl"
  42.         :XMN_TITLE            "Accelerator Test"
  43.         :XMN_ICON_NAME            "Accel"
  44.         :XMN_KEYBOARD_FOCUS_POLICY    :explicit
  45.         ))
  46.     (setq paned_w
  47.       (send XM_PANED_WINDOW_WIDGET_CLASS :new :managed
  48.         "pane" top_w
  49.         ))
  50.     (setq rc_w
  51.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed
  52.         "rc" paned_w
  53.         :XMN_ORIENTATION    :horizontal
  54.         :XMN_PACKING        :pack_column
  55.         :XMN_NUM_COLUMNS    2
  56.         :XMN_ADJUST_LAST    nil
  57.         ))
  58.  
  59.     ;;
  60.     ;; For each letter in alphabet, create a pushbutton widget... install
  61.     ;; accelerators from all other widgets onto each pushbutton widget.
  62.     ;;
  63.     (mapcar
  64.      (lambda (widget)
  65.        (send widget :install_all_accelerators top_w)
  66.        )
  67.      (mapcar
  68.       (lambda (letter)
  69.     (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed
  70.           "pb" rc_w
  71.           :XMN_LABEL_STRING (format nil "~A"
  72.                     letter)
  73.           :XMN_ACCELERATORS (format nil "<Key>~A: ArmAndActivate()"
  74.                     letter)
  75.           ))
  76.       '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\* #\/ #\+
  77.     #\- #\[ #\] #\; #\' #\` #\. #\~ #\! #\@ #\# #\$ #\%
  78.     #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
  79.     #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))
  80.      )
  81.  
  82.     ;;
  83.     ;; turn this example into the worlds most inefficient version of 
  84.     ;; keyboard echo... application will echo characters typed in via keyboard
  85.     ;; to the text widget text_w...
  86.     ;;
  87.     (setq text_w
  88.       (send XM_TEXT_WIDGET_CLASS :new :managed :scrolled
  89.         "edit" paned_w
  90.         ))
  91.  
  92.     (let ((position 0))
  93.       (send rc_w :add_callback :xmn_entry_callback '(CALLBACK_ENTRY_WIDGET)
  94.         '(
  95.           (send text_w :insert position
  96.             (xm_string_get_l_to_r
  97.              (car (send CALLBACK_ENTRY_WIDGET :get_values :xmn_label_string nil))))
  98.           (setq position (1+ position))
  99.           (send text_w :show_position position)
  100.           ))
  101.       )
  102.  
  103.     (send text_w :uninstall_translations)
  104.     (send text_w :install_all_accelerators top_w)
  105.  
  106.     (send top_w :realize)
  107.     )
  108.   )
  109.